home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / e33el2.zip / emacs / 19.33 / lisp / yow.el < prev   
Lisp/Scheme  |  1996-01-20  |  4KB  |  131 lines
  1. ;;; yow.el --- quote random zippyisms
  2.  
  3. ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
  4.  
  5. ;; Maintainer: FSF
  6. ;; Author: Richard Mlynarik
  7. ;; Keywords: games
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;; Important pinheadery for GNU Emacs.
  29. ;;
  30. ;; See cookie1.el for implementation.  Note --- the `n' argument of yow
  31. ;; from the 18.xx implementation is no longer; we only support *random*
  32. ;; random access now.
  33.  
  34. ;;; Code:
  35.  
  36. (require 'cookie1)
  37.  
  38. (defvar yow-file (concat data-directory "yow.lines")
  39.    "File containing pertinent pinhead phrases.")
  40.  
  41. (defconst yow-load-message "Am I CONSING yet?...")
  42. (defconst yow-after-load-message "I have SEEN the CONSING!!")
  43.  
  44. ;;;###autoload
  45. (defun yow (&optional insert)
  46.   "Return or display a random Zippy quotation.  With prefix arg, insert it."
  47.   (interactive "P")
  48.   (let ((yow (cookie yow-file yow-load-message yow-after-load-message)))
  49.     (cond (insert
  50.        (insert yow))
  51.       ((not (interactive-p))
  52.        yow)
  53.       ((not (string-match "\n" yow))
  54.        (delete-windows-on (get-buffer-create "*Help*"))
  55.        (message "%s" yow))
  56.       (t
  57.        (message "Yow!")
  58.        (with-output-to-temp-buffer "*Help*"
  59.          (princ yow)
  60.          (save-excursion
  61.            (set-buffer standard-output)
  62.            (help-mode)))))))
  63.  
  64. (defsubst read-zippyism (prompt &optional require-match)
  65.   "Read a Zippyism from the minibuffer with completion, prompting with PROMPT.
  66. If optional second arg is non-nil, require input to match a completion."
  67.   (read-cookie prompt yow-file yow-load-message yow-after-load-message
  68.            require-match))
  69.  
  70. ;;;###autoload
  71. (defun insert-zippyism (&optional zippyism)
  72.   "Prompt with completion for a known Zippy quotation, and insert it at point."
  73.   (interactive (list (read-zippyism "Pinhead wisdom: " t)))
  74.   (insert zippyism))
  75.  
  76. ;;;###autoload
  77. (defun apropos-zippy (regexp)
  78.   "Return a list of all Zippy quotes matching REGEXP.
  79. If called interactively, display a list of matches."
  80.   (interactive "sApropos Zippy (regexp): ")
  81.   ;; Make sure yows are loaded
  82.   (cookie yow-file yow-load-message yow-after-load-message)
  83.   (let* ((case-fold-search t)
  84.          (cookie-table-symbol (intern yow-file cookie-cache))
  85.          (string-table (symbol-value cookie-table-symbol))
  86.          (matches nil)
  87.          (len (length string-table))
  88.          (i 0))
  89.     (save-match-data
  90.       (while (< i len)
  91.         (and (string-match regexp (aref string-table i))
  92.              (setq matches (cons (aref string-table i) matches)))
  93.         (setq i (1+ i))))
  94.     (and matches
  95.          (setq matches (sort matches 'string-lessp)))
  96.     (and (interactive-p)
  97.          (cond ((null matches)
  98.                 (message "No matches found."))
  99.                (t
  100.                 (let ((l matches))
  101.                   (with-output-to-temp-buffer "*Zippy Apropos*"
  102.                     (while l
  103.                       (princ (car l))
  104.                       (setq l (cdr l))
  105.                       (and l (princ "\n\n"))))))))
  106.     matches))
  107.  
  108.  
  109. ;; Yowza!! Feed zippy quotes to the doctor. Watch results.
  110. ;; fun, fun, fun. Entertainment for hours...
  111. ;;
  112. ;; written by Kayvan Aghaiepour
  113.  
  114. ;;;###autoload
  115. (defun psychoanalyze-pinhead ()
  116.   "Zippy goes to the analyst."
  117.   (interactive)
  118.   (doctor)                ; start the psychotherapy
  119.   (message "")
  120.   (switch-to-buffer "*doctor*")
  121.   (sit-for 0)
  122.   (while (not (input-pending-p))
  123.     (insert-string (yow))
  124.     (sit-for 0)
  125.     (doctor-ret-or-read 1)
  126.     (doctor-ret-or-read 1)))
  127.  
  128. (provide 'yow)
  129.  
  130. ;;; yow.el ends here
  131.